Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-19/lyrmastr.zip/LYRMASTR.LSP

Text File | 1991-05-09 | 8KB | 2 lines

(DEFUN Qj(Q@)(SETQ *ERROR* QQ)(IF(= Q@"Function cancelled")(PROMPT"\nLMERR: Function cancelled.")(PROMPT(STRCAT"\nLMERR: "Q@)))(PRIN1))(DEFUN Ql(Q& Q1 Q# / Q0 Q$ QO)(SETQ Q$(STRCAT Q&","))(SETQ QO(STRCAT Q1","))(SETQ Q| NIL)(SETQ Q0 Q#)(WHILE(AND(NOT Q|)(<= Q0(STRLEN QO)))(IF(=(SUBSTR QO Q0(STRLEN Q$))Q$)(SETQ Q| Q0)(SETQ Q0(+ Q0 1))))Q|)(DEFUN Q%(Q?j / Qjj Q@j QQj Qlj Q&j Q1j Q#j)(SETQ Q&j Q?j)(SETQ Q@j(quote ()))(SETQ Qlj(ENTSEL(STRCAT"\nPick entity for group "Q&j" or press <enter> for all thawed layers: ")))(IF Qlj(PROGN(WHILE Qlj(SETQ Q@j(APPEND Q@j(LIST(CDR(ASSOC 8(ENTGET(CAR Qlj)))))))(SETQ Qlj(ENTSEL(STRCAT"\nPick entity for group "Q&j": "))))(PROMPT"\nGrouping chosen layers.  Please wait ..."))(PROGN(PROMPT"\nGrouping all thawed layers.  Please wait ...")(SETQ Q@j(APPEND Q@j(LIST(GETVAR"clayer"))))(TBLNEXT"layer"T)(WHILE(SETQ Qjj(TBLNEXT"layer"))(IF(AND(/=(CDR(ASSOC 2 Qjj))(NTH 0 Q@j))(=(CDR(ASSOC 70 Qjj))64))(SETQ Q@j(APPEND Q@j(LIST(CDR(ASSOC 2 Qjj)))))))))(IF Q0j(IF(SETQ Q1j(ASSOC Q&j Q0j))(SETQ Q#j(STRCAT(CDR Q1j)","))(SETQ Q#j""))(SETQ Q#j""))(FOREACH QQj Q@j(IF(NOT(Ql QQj Q#j 1))(SETQ Q#j(STRCAT Q#j QQj","))))(SETQ Q#j(SUBSTR Q#j 1(-(STRLEN Q#j)1)))(PROMPT" done.")Q#j)(DEFUN Q$j(/ Qlj)(SETQ Qlj(ENTSEL"\nSet new current layer.  Choose entity: "))(IF Qlj(COMMAND"layer""s"(CDR(ASSOC 8(ENTGET(CAR Qlj))))"")))(DEFUN QOj(/ Q|j Q%j Qlj)(SETQ Q%j"")(SETQ Qlj(ENTSEL"\nFreeze layer.  Choose entity: "))(WHILE Qlj(SETQ Q%j(STRCAT Q%j(CDR(ASSOC 8(ENTGET(CAR Qlj))))","))(SETQ Qlj(ENTSEL"\nFreeze layer.  Choose entity: ")))(IF(/= Q%j"")(PROGN(SETQ Q%j(SUBSTR Q%j 1(-(STRLEN Q%j)1)))(COMMAND"layer""f"Q%j""))))(DEFUN Q?@(/ Q|j Qj@ Qlj)(PROMPT"\nChange entity(s) to CURRENT layer.")(SETQ Qj@(SSGET))(IF Qj@(COMMAND"chprop"(EVAL Qj@)"""la"(GETVAR"clayer")""))(SETQ Qj@ NIL)(GC))(DEFUN Q@@(QQ@ Ql@ / Qlj Q&@ Q&j Q1@ Q#@ Q0@)(IF Q0j(PROGN(SETQ Q1@ QQ@)(SETQ Q#@ Ql@)(IF Q1@(PROGN(SETQ Qlj(ENTSEL"\nPick entity in group: "))(IF Qlj(PROGN(SETQ Qlj(ENTGET(CAR Qlj)))(SETQ Q0 0)(WHILE(SETQ Q&@(NTH Q0 Q0j))(IF(Ql(CDR(ASSOC 8 Qlj))(CDR Q&@)1)(SETQ Q&j(CAR Q&@)))(SETQ Q0(+ Q0 1))))(SETQ Q&j NIL))))(IF(AND Q#@(NOT Q&j))(PROGN(SETQ Q&j(GETSTRING"\nGroup name: "))(SETQ Q&j(STRCASE Q&j)))))(PROMPT"\nNo defined layer groups exist!"))(IF(NOT Q&j)NIL(PROGN(PROMPT Q&j)(ASSOC Q&j Q0j))))(DEFUN Q$@(/ QO@ Q&j Q#j Q|@)(SETQ Q|@(quote ()))(SETQ QO@(OPEN(STRCAT(GETVAR"dwgname")".lm")"r"))(IF QO@(PROGN(SETQ Q&j(READ-LINE QO@))(WHILE Q&j(SETQ Q#j(READ-LINE QO@))(SETQ Q|@(CONS(CONS Q&j Q#j)Q|@))(SETQ Q&j(READ-LINE QO@)))(CLOSE QO@)))Q|@)(DEFUN Q%@(/ QO@ Q&@)(SETQ QO@(OPEN(STRCAT(GETVAR"dwgname")".lm")"w"))(FOREACH Q&@ Q0j(WRITE-LINE(CAR Q&@)QO@)(WRITE-LINE(CDR Q&@)QO@))(CLOSE QO@))(DEFUN Q?Q()(TEXTSCR)(PROMPT"\nLayer Master Main Command Set:")(PROMPT"\n  Freeze - Freeze layer by picking any entity on that layer.")(PROMPT"\n     Set - Set the current layer by picking any entity on that layer.")(PROMPT"\n  Change - Pick any entity to change it's layer to the current layer.")(PROMPT"\n  seLect - Pick any entity and all entities on that layer will be")(PROMPT"\n           placed in the PREVIOUS selection set.")(PROMPT"\n   Group - Freeze/Thaw/Isolate/Define/Undefine/List/Save/Help for layer groups.")(PROMPT"\n    Help - Displays this screen.")(PROMPT"\n  <Q>uit - Default command.  Quit Layer Master.")(PROMPT"\nPress your favorite key ...")(GETSTRING)(GRAPHSCR))(DEFUN QjQ()(TEXTSCR)(PROMPT"\nLayer Master Layer Group Command Set:")(PROMPT"\n  Freeze - Freeze a layer group by picking any entity in that group.")(PROMPT"\n    Thaw - Thaw any layer group by typing it's name.")(PROMPT"\n Isolate - Isolate a layer group by picking any entity in that group.")(PROMPT"\n  Define - Define a layer group by picking entities on different layers.")(PROMPT"\n           The default group has no name.  Access it with the enter key.")(PROMPT"\nUndefine - Remove a layer group's definition from the group configuration.")(PROMPT"\n   Print - List all layer groups or pick any entity to check it's group name.")(PROMPT"\n    Save - Save group configuration to disk in file DWGNAME.LM.")(PROMPT"\n  seLect - Pick any entity and all entities in that layer group will be")(PROMPT"\n           placed in the PREVIOUS selection set.")(PROMPT"\n    Help - Display this screen.")(PROMPT"\n  <Q>uit - Default command.  Quit group commands.")(PROMPT"\nPress your favorite key ...")(GETSTRING)(GRAPHSCR))(DEFUN Q@Q(/ QQQ QlQ Q&Q Q1Q Q#Q Q0Q Q$Q)(SETQ QQQ(GETVAR"viewctr"))(SETQ QlQ(GETVAR"viewsize"))(SETQ Q&Q(GETVAR"screensize"))(SETQ Q1Q(/(NTH 0 Q&Q)(NTH 1 Q&Q)))(SETQ Q#Q(* QlQ Q1Q))(SETQ Q0Q(-(NTH 0 QQQ)(/ Q#Q 2.0)))(SETQ Q$Q(-(NTH 1 QQQ)(/ QlQ 2.0)))(LIST(LIST Q0Q Q$Q)(LIST(+ Q0Q Q#Q)(+ Q$Q QlQ))))(DEFUN C:LYRMASTR(/ QOQ Q|Q Q%Q Q?l Q|Q Q?j Qlj Qjl QQj Q0@)(SETQ QQ *ERROR*)(SETQ *ERROR* Qj)(IF(NOT Q0j)(PROGN(SETQ Q0j(Q$@))(IF(NOT Q0j)(SETQ Q0j(quote ())))))(SETQ Q%Q(GETVAR"cmdecho"))(SETVAR"cmdecho"0)(INITGET"F f S s C c L l G g Q q H h")(SETQ QOQ(GETSTRING"\nLM Command (F/S/C/L/G/H/<Q>): "))(SETQ QOQ(STRCASE QOQ))(IF(= QOQ"")(SETQ QOQ"Q"))(WHILE(/= QOQ"Q")(COND((= QOQ"F")(QOj))((= QOQ"S")(Q$j))((= QOQ"C")(Q?@))((= QOQ"G")(SETQ Q?l(GETSTRING"\nLM Group command (F/T/I/D/U/P/S/L/H/<Q>): "))(SETQ Q?l(STRCASE Q?l))(IF(= Q?l"")(SETQ Q?l"Q"))(WHILE(/= Q?l"Q")(COND((= Q?l"F")(SETQ Q@l(Q@@ T T))(IF Q@l(COMMAND"layer""f"(CDR Q@l)"")))((= Q?l"T")(SETQ Q@l(Q@@ NIL T))(IF Q@l(COMMAND"layer""t"(CDR Q@l)"")))((= Q?l"I")(SETQ Q@l(Q@@ T T))(IF Q@l(COMMAND"layer""t"(SUBSTR(CDR Q@l)1(-(Ql""(CDR Q@l)1)1))"s"(SUBSTR(CDR Q@l)1(-(Ql""(CDR Q@l)1)1))"f""*""t"(CDR Q@l)"")))((= Q?l"D")(SETQ Q?j(GETSTRING"\nGroup name or <enter> for default group: "))(SETQ Q?j(STRCASE Q?j))(SETQ Q@l(ASSOC Q?j Q0j))(SETQ Q|Q NIL)(IF Q@l(PROGN(SETQ Q|Q"")(SETQ Q|Q(GETSTRING(STRCAT"\nGroup "Q?j" already exists.  Redefine it? (Y/<N>): ")))(SETQ Q|Q(STRCASE Q|Q))))(IF(OR(NOT Q|Q)(= Q|Q"Y"))(PROGN(SETQ Q@l(Q% Q?j))(IF(ASSOC Q?j Q0j)(SETQ Q0j(SUBST(CONS Q?j Q@l)(ASSOC Q?j Q0j)Q0j))(SETQ Q0j(CONS(CONS Q?j Q@l)Q0j))))))((= Q?l"U")(SETQ Q?j(Q@@ T T))(IF Q?j(PROGN(SETQ Q0@(quote ()))(FOREACH QQj Q0j(IF(NOT(EQUAL QQj Q?j))(SETQ Q0@(CONS QQj Q0@))))(SETQ Q0j Q0@)(SETQ Q0@ NIL))))((= Q?l"P")(SETQ Q?j(Q@@ T NIL))(IF(NOT Q?j)(PROGN(PROMPT"\nDefined layer groups: \n")(FOREACH Q&@ Q0j(WRITE-LINE(STRCAT(STRCASE(CAR Q&@))":\n"(CDR Q&@)"\n")))(GETSTRING"\nPress your favorite key ..."))(PROMPT(STRCAT"\nEntity picked in Group: "(CAR Q?j)))))((= Q?l"S")(Q%@))((= Q?l"L")(SETQ Q@l(Q@@ T T))(IF Q@l(PROGN(PROMPT(STRCAT"\nSelecting entities in layer group: "(CAR Q@l)".  Please wait ..."))(COMMAND"layer""t"(SUBSTR(CDR Q@l)1(-(Ql""(CDR Q@l)1)1))"s"(SUBSTR(CDR Q@l)1(-(Ql""(CDR Q@l)1)1))"f""*""t"(CDR Q@l)"")(COMMAND"zoom""e")(SETQ Qjl(Q@Q))(SSGET"c"(NTH 0 Qjl)(NTH 1 Qjl))(COMMAND"zoom""p")(PROMPT"done.\n"))))((= Q?l"H")(QjQ))(NIL T))(SETQ Q?l(GETSTRING"\nLM Group command (F/T/I/D/U/P/S/L/H/<Q>): "))(SETQ Q?l(STRCASE Q?l))(IF(= Q?l"")(SETQ Q?l"Q"))))((= QOQ"L")(SETQ Qlj(ENTSEL"\nPick any entity for PREVIOUS selection set: "))(IF Qlj(PROGN(SETQ Qlj(ENTGET(CAR Qlj)))(PROMPT(STRCAT"\nSelecting entities on layer: "(CDR(ASSOC 8 Qlj))".  Please wait ..."))(SSGET"x"(LIST(CONS 8(CDR(ASSOC 8 Qlj)))))(PROMPT"done.\n"))))((= QOQ"H")(Q?Q))(NIL T))(INITGET"F f S s C c G g Q q H h")(SETQ QOQ(GETSTRING"\nLM Command (F/S/C/L/G/H/<Q>): "))(SETQ QOQ(STRCASE QOQ))(IF(= QOQ"")(SETQ QOQ"Q")))(SETVAR"cmdecho"Q%Q)(SETQ *ERROR* QQ)(PRIN1))(PROMPT"\n****  C:LYRMASTR, LAYER MASTER Ver 2.0 (c) Copyright 1991 CADD Masters  ****")(PRIN1)